home *** CD-ROM | disk | FTP | other *** search
/ UpTime Volume 1 #9 / utv1n9s2.d64 / fn edit (.txt) < prev    next >
Commodore BASIC  |  2022-08-28  |  4KB  |  176 lines

  1. 100 rem function key editor
  2. 110 rem copyright (c) 1987
  3. 120 rem john m. campbell
  4. 130 rem all rights reserved
  5. 140 print "define function keys"
  6. 150 for i=1to8:df$(i)=chr$(222):nexti
  7. 160 ba=51000:ad=ba
  8. 170 a0=peek(655):a1=peek(656)
  9. 180 if ba+27<>a0+256*a1 then 220
  10. 190 print "function keys already defined"
  11. 200 print "type stop+restore keys then re-run"
  12. 210 goto 910
  13. 220 print "loading ml program into memory"
  14. 230 for i=1to82
  15. 240 read a
  16. 250 poke ad,a
  17. 260 ad=ad+1
  18. 270 next i
  19. 280 rem address-dependent code
  20. 290 vh=((ba+25)/256)and255:vl=(ba+25)-256*vh
  21. 300 poke ba+5,vl
  22. 310 poke ba+6,vh
  23. 320 wh=((ba+26)/256)and255:wl=(ba+26)-256*wh
  24. 330 poke ba+11,wl
  25. 340 poke ba+12,wh
  26. 350 sh=((ba+27)/256)and255:sl=(ba+27)-256*vh
  27. 360 poke ba+14,sl
  28. 370 poke ba+19,sh
  29. 380 ih=((ba+71)/256)and255:il=(ba+71)-256*ih
  30. 390 poke ba+53,il
  31. 400 poke ba+54,ih
  32. 410 th=((ba+82)/256)and255:tl=(ba+82)-256*th
  33. 420 poke ba+58,tl
  34. 430 poke ba+59,th
  35. 440 poke ba+72,vl
  36. 450 poke ba+73,vh
  37. 460 gosub 1310:rem check for default file
  38. 470 fk=0:gosub 1740:rw=20:cl=0:gosub 1680
  39. 480 fk=0:input"number of key to define";fk
  40. 490 gosub 1780
  41. 500 if fk=0 then 620
  42. 510 if fk<0 or fk>8 then print "invalid function key number":goto 470
  43. 520 rem prompt for string
  44. 530 a$=df$(fk):if a$="" then a$=chr$(222)
  45. 540 gosub 1740:rw=20:cl=0:gosub 1680
  46. 550 print "new string (def="+a$+")? ";
  47. 560 gosub 1010:rem process inputs
  48. 570 rw=8+fk:cl=21:gosub 1680
  49. 580 print "          "
  50. 590 rw=8+fk:cl=21:gosub 1680
  51. 600 print df$(fk)
  52. 610 goto 470
  53. 620 rem end processing
  54. 630 print "writing fn key definitions into memory"
  55. 640 for i=1to8
  56. 650 ll=len(df$(i))
  57. 660 for j=1to11
  58. 670 if j=ll+1 then a=0:goto 720
  59. 680 if j>ll then a=32:goto 720
  60. 690 a=asc(mid$(df$(i),j,1))
  61. 700 if a=95 then a=13
  62. 710 if a=222 then a=0:ll=0
  63. 720 poke ad,a:ad=ad+1
  64. 730 next j
  65. 740 next i
  66. 750 input "create default file (y/n)";a$
  67. 760 if a$<>"y" then 880
  68. 770 print#15,"s0:fn defs"
  69. 780 open 3,8,3,"0:fn defs,s,w"
  70. 790 input#15,en,em$,et,es
  71. 800 if en<>0 then print "unable to create default file":goto 860
  72. 810 print "writing default values"
  73. 820 for i=1to8
  74. 830 print#3,df$(i)
  75. 840 rem print "fn key";i;"=";df$(i)
  76. 850 nexti
  77. 860 close3
  78. 870 gosub 1540
  79. 880 print "activating function keys"
  80. 890 sys ba
  81. 900 close15
  82. 910 end
  83. 920 data 120,173,143,2,141,0,0,173,144,2
  84. 930 data 141,0,0,169,0,141,143,2,169,0
  85. 940 data 141,144,2,88,96,0,0,166,203
  86. 950 data 228,197,240,38,224,3,144,34
  87. 960 data 224,7,176,30,173,141,2,106
  88. 970 data 144,5,138,24,105,4,170,188,0,0
  89. 980 data 162,0,185,0,0,240,9,230,198
  90. 990 data 157,119,2,232,200,208,242
  91. 1000 data 108,0,0,66,0,22,44,77,11,33,55
  92. 1010 rem get input string
  93. 1020 ll=0:aa$="":cs=0:print chr$(114);
  94. 1030 poke 212,0:rem quote mode off
  95. 1040 get a$:a=asc(a$+chr$(0)):if a=0 then gosub 1260:goto 1040
  96. 1050 if a=20 and ll=0 then 1040
  97. 1060 if a=13 then print chr$(157)chr$(32):goto 1240
  98. 1070 if a<>20 then 1130
  99. 1080 rem process delete
  100. 1090 ll=ll-1
  101. 1100 aa$=mid$(aa$,1,ll)
  102. 1110 print chr$(157)chr$(32)chr$(157)a$chr$(114);:cs=1
  103. 1120 goto 1040
  104. 1130 if ll=10 then 1230
  105. 1140 rem add character to string
  106. 1150 aa$=aa$+a$
  107. 1160 ll=ll+1
  108. 1170 print chr$(157)chr$(32)chr$(157)a$chr$(114);:cs=1
  109. 1180 if a=34 then poke 212,0
  110. 1190 if a<>222 then 1040
  111. 1200 rem null string
  112. 1210 print chr$(157)chr$(32):print"fn key definition deleted"
  113. 1220 goto 1240
  114. 1230 print chr$(157)chr$(32):print "exceeded 10-character maximum"
  115. 1240 if ll<>0 then df$(fk)=aa$
  116. 1250 return
  117. 1260 rem cursor control
  118. 1270 if cs=0 then print chr$(157)chr$(114);
  119. 1280 if cs=10 then cs=-10:print chr$(157)chr$(32);
  120. 1290 cs=cs+1
  121. 1300 return
  122. 1310 rem open file and read defaults
  123. 1320 print "searching for default file"
  124. 1330 open 15,8,15,"i"
  125. 1340 open 2,8,2,"0:fn defs,s,r"
  126. 1350 input#15,en,em$,et,es
  127. 1360 if en<>0 then print "no default definitions found":goto 1520
  128. 1370 print "reading default values"
  129. 1380 for i=1to8
  130. 1390 df$(i)=""
  131. 1400 get#2,a$
  132. 1410 if a$=chr$(13) then 1440
  133. 1420 df$(i)=df$(i)+a$
  134. 1430 goto 1400
  135. 1440 next i
  136. 1450 print chr$(147)
  137. 1460 rw=5:cl=10:gosub 1680
  138. 1470 print "function key editor"
  139. 1480 for i=1 to 8
  140. 1490 rw=8+i:cl=10:gosub 1680
  141. 1500 print "fn key";i;"= ";df$(i)
  142. 1510 next i
  143. 1520 close 2
  144. 1530 return
  145. 1540 rem store load file
  146. 1550 print#15,"s0:fn keys"
  147. 1560 input#15,en,em$,et,es
  148. 1570 open 2,8,1,"0:fn keys,p,w"
  149. 1580 input#15,en,em$,et,es
  150. 1590 bh=(ba/256)and255
  151. 1600 bl=ba-256*bh
  152. 1610 print#2,chr$(bl);
  153. 1620 print#2,chr$(bh);
  154. 1630 for i=0to168
  155. 1640 print#2,chr$(peek(ba+i));
  156. 1650 nexti
  157. 1660 close2
  158. 1670 return
  159. 1680 rem set cursor to (rw,cl)
  160. 1690 poke 781,rw
  161. 1700 poke 782,cl
  162. 1710 poke 783,0
  163. 1720 sys 65520 : rem call kernal plot routine
  164. 1730 return
  165. 1740 rem clear prompt line
  166. 1750 rw=20:cl=0:gosub 1680
  167. 1760 print "                                        "
  168. 1770 return
  169. 1780 rem clear message line
  170. 1790 rw=21:cl=0:gosub 1680
  171. 1800 print "                                        "
  172. 1810 rw=22:cl=0:gosub 1680
  173. 1820 print "                                        "
  174. 1830 rw=22:cl=0:gosub 1680
  175. 1840 return
  176.